home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS26.ADF / HexDump / Hex.mod < prev    next >
Text File  |  1989-01-26  |  5KB  |  169 lines
  1. IMPLEMENTATION MODULE Hex;
  2.  
  3. FROM InOut          IMPORT WriteString, WriteLn, WriteCard;
  4.  
  5. FROM LongInOut      IMPORT WriteLongCard, WriteLongHex;
  6.  
  7. FROM Strings        IMPORT Length;
  8.  
  9. FROM SYSTEM         IMPORT LONGWORD, ADDRESS, TSIZE;
  10.  
  11.    PROCEDURE ConvertHexStringToCardinal (VAR Num     : LONGCARD;
  12.                                          NumLocation : str80);
  13.  
  14.    (* This procedure converts the hex input string to cardinal in
  15.       order to convert to an address. *)
  16.  
  17.    VAR
  18.       Index    : INTEGER;
  19.       Temp     : CARDINAL;
  20.       Temp1    : LONGCARD;
  21.       Dummy    : CHAR;
  22.       MaxCount : INTEGER;
  23.    BEGIN
  24.       Index := 0;
  25.       MaxCount := Length(NumLocation);(* This is different than HexDump *)
  26.       WHILE Index < MaxCount DO
  27.          Dummy := NumLocation[Index];
  28.          IF((Dummy >= 'A') AND (Dummy <= 'F')) THEN
  29.             Temp := ORD(Dummy) - ORD('A') + 10;
  30.          ELSE
  31.             Temp := ORD(Dummy) - ORD('0');
  32.          END;(* IF *)
  33.          Temp1 := LONGCARD(Temp);
  34.          Num := 16 * Num + Temp1;
  35.          Index := Index + 1;
  36.       END; (* WHILE *)
  37.       RETURN;
  38.    END ConvertHexStringToCardinal;
  39.  
  40.    PROCEDURE HexDump( StartAddress : ADDRESS;
  41.                       WordCount    : LONGCARD;
  42.                       Out          : OutType);
  43.  
  44.       (* This procedure dumps memory in hex. *)
  45.  
  46.       VAR
  47.          loc   : ADDRESS;
  48.          count : LONGCARD;
  49.  
  50.       BEGIN
  51.          loc := StartAddress;
  52.          FOR count := 1 TO WordCount DO
  53.          (* Write the line starting address and keep line to a length
  54.             of eight.*)
  55.             IF count MOD 8 = 1 THEN
  56.                WriteLongHex(LONGCARD(loc),8);
  57.                WriteString(': ');
  58.             END;(* IF *)
  59.             (* Write the hex value of memory. *)
  60.             WriteHex(CARDINAL(loc^),LeftByte,RightByte,Out);
  61.             INC(loc,TSIZE(CARDINAL));
  62.             WriteString(Out);
  63.             WriteString('  ');
  64.             WriteChar(CharOut,CharIndex,LeftByte,RightByte);
  65.             IF (count MOD 8 = 0) THEN
  66.                WriteString(CharOut);
  67.                WriteLn;
  68.             END; (* IF *)
  69.          END;(* FOR *)
  70.          WriteLn;
  71.          RETURN;
  72.    END HexDump;
  73.  
  74.    PROCEDURE WriteHex(    Input     : CARDINAL;
  75.                       VAR LeftByte  : CARDINAL;
  76.                       VAR RightByte : CARDINAL;
  77.                       VAR Out       : OutType);
  78.    TYPE
  79.       DivisorType = ARRAY[0..3] OF CARDINAL;
  80.    VAR
  81.       Index   : CARDINAL;
  82.       Temp    : CARDINAL;
  83.       Divisor : DivisorType;
  84.       x       : CARDINAL;
  85.  
  86.    PROCEDURE HexOut(Temp  : CARDINAL;
  87.                     VAR Out : OutType;
  88.                     Index : CARDINAL);
  89.  
  90.       BEGIN
  91.          CASE Temp OF
  92.             0 : Out[Index] := '0' |
  93.             1 : Out[Index] := '1' |
  94.             2 : Out[Index] := '2' |
  95.             3 : Out[Index] := '3' |
  96.             4 : Out[Index] := '4' |
  97.             5 : Out[Index] := '5' |
  98.             6 : Out[Index] := '6' |
  99.             7 : Out[Index] := '7' |
  100.             8 : Out[Index] := '8' |
  101.             9 : Out[Index] := '9' |
  102.            10 : Out[Index] := 'A' |
  103.            11 : Out[Index] := 'B' |
  104.            12 : Out[Index] := 'C' |
  105.            13 : Out[Index] := 'D' |
  106.            14 : Out[Index] := 'E' |
  107.            15 : Out[Index] := 'F';
  108.          END; (* CASE *)
  109.          RETURN;
  110.    END HexOut;
  111.  
  112.    BEGIN
  113.       Divisor[0] := 4096;
  114.       Divisor[1] := 256;
  115.       Divisor[2] := 16;
  116.       Divisor[3] := 1;
  117.       FOR Index := 0 TO 3 DO
  118.          IF Index = 2 THEN
  119.             (* Save the right byte. *)
  120.             RightByte := Input;
  121.             LeftByte  := 0;
  122.             FOR x := 0 TO 1 DO
  123.             (* Get the left byte. *)
  124.                IF((Out[x] >= 'A') AND (Out[x] <= 'F')) THEN
  125.                   LeftByte := 16 * LeftByte + (ORD(Out[x]) -
  126.                              ORD('A') + 10);
  127.                ELSE
  128.                   LeftByte := 16 * LeftByte + ORD(Out[x]) - ORD('0');
  129.                END; (* IF *)
  130.             END; (* FOR *)
  131.          END; (* IF *)
  132.          Temp := Input DIV Divisor[Index];
  133.          (* Generate hex output. *)
  134.          HexOut(Temp,Out,Index);
  135.          Input := Input - Temp * Divisor[Index];
  136.       END; (* FOR *)
  137.       RETURN;
  138.    END WriteHex;
  139.  
  140.    PROCEDURE WriteChar(VAR CharOut   : CharType;
  141.                        VAR CharIndex : CARDINAL;
  142.                            LeftByte  : CARDINAL;
  143.                            RightByte : CARDINAL);
  144.  
  145.    (* This procedure generates the ASCII equivalent of the hex values. *)
  146.  
  147.    BEGIN
  148.    (* For the left byte generate ASCII character else generate a 
  149.       period. *)
  150.       IF((CHR(19H)<CHR(LeftByte))AND(CHR(LeftByte)<CHR(7EH))) THEN
  151.          CharOut[CharIndex] := CHR(LeftByte);
  152.       ELSE
  153.          CharOut[CharIndex] := CHR(2EH);
  154.       END; (* IF *)
  155.       CharIndex := CharIndex + 1;
  156.       (* For the right byte generate ASCII character else generate a
  157.          period. *)
  158.       IF((CHR(19H)<CHR(RightByte))AND(CHR(RightByte)<CHR(7EH))) THEN
  159.          CharOut[CharIndex] := CHR(RightByte);
  160.       ELSE
  161.          CharOut[CharIndex] := CHR(2EH);
  162.       END; (* IF *)
  163.       CharIndex := CharIndex + 1;
  164.       IF CharIndex = 17 THEN CharIndex := 1 END;
  165.       RETURN;
  166.    END WriteChar;
  167.  
  168. END Hex.
  169.